home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / Rotate Bitmap 1.0 / Rotate.p < prev   
Encoding:
Text File  |  1995-04-15  |  4.4 KB  |  159 lines  |  [TEXT/PJMM]
  1. program Rotate;
  2.  
  3.     const
  4.         BIT00 = $01;
  5.         BIT01 = $02;
  6.         BIT02 = $04;
  7.         BIT03 = $08;
  8.         BIT04 = $10;
  9.         BIT05 = $20;
  10.         BIT06 = $40;
  11.         BIT07 = $80;
  12.  
  13.     var
  14.         macBitMap: BitMap;
  15.  
  16.     procedure Rotate;
  17.         var
  18.             srcPtr, destPtr, destColPtr: Ptr;
  19.             newBitmap: BitMap;
  20.             bitchar, srcByte, srcH, srcV, srccols, srcrows, i: Integer;
  21.  
  22.     (* rotate boundary rectangle *)
  23.     begin
  24.         srcH := macBitMap.bounds.right - macBitMap.bounds.left;
  25.         srcV := macBitMap.bounds.bottom - macBitMap.bounds.top;
  26.         SetRect(newBitMap.bounds, macBitMap.bounds.left, macBitMap.bounds.top, macBitMap.bounds.left + srcV, macBitMap.bounds.top + srcH);
  27.  
  28.     (* allocate destination buffer *)
  29.         newBitMap.rowBytes := BSR(srcV + 7, 3);
  30.  
  31.         newBitMap.baseAddr := NewPtrClear(newBitMap.rowBytes * srcH);
  32.         newBitMap.bounds := newBitMap.bounds;
  33.  
  34.     (* set-up src to rotated destination scan *)
  35.         srccols := macBitMap.rowBytes;
  36.         srcrows := srcV;
  37.         srcPtr := macBitMap.baseAddr;
  38.         bitchar := BIT00;
  39.         destColPtr := Ptr(Longint(newBitMap.baseAddr) + newBitMap.rowBytes - 1);
  40.         destPtr := destColPtr;
  41.  
  42.         srcrows := srcrows - 1;
  43.  
  44.     (* scan src row and rotate into dest col *)
  45.         while srcrows > 0 do
  46.             begin
  47.                 for i := 0 to srccols - 1 do
  48.                     begin
  49.                         srcByte := srcPtr^;
  50.                         srcPtr := Ptr(Longint(srcPtr) + 1);
  51.                         if BAnd(srcByte, BIT07) <> 0 then
  52.                             destPtr^ := BitOr(destPtr^, bitchar);
  53.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  54.                         if BAnd(srcByte, BIT06) <> 0 then
  55.                             destPtr^ := BitOr(destPtr^, bitchar);
  56.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  57.                         if BAnd(srcByte, BIT05) <> 0 then
  58.                             destPtr^ := BitOr(destPtr^, bitchar);
  59.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  60.                         if BAnd(srcByte, BIT04) <> 0 then
  61.                             destPtr^ := BitOr(destPtr^, bitchar);
  62.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  63.                         if BAnd(srcByte, BIT03) <> 0 then
  64.                             destPtr^ := BitOr(destPtr^, bitchar);
  65.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  66.                         if BAnd(srcByte, BIT02) <> 0 then
  67.                             destPtr^ := BitOr(destPtr^, bitchar);
  68.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  69.                         if BAnd(srcByte, BIT01) <> 0 then
  70.                             destPtr^ := BitOr(destPtr^, bitchar);
  71.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  72.                         if BAnd(srcByte, BIT00) <> 0 then
  73.                             destPtr^ := BitOr(destPtr^, bitchar);
  74.                         destPtr := Ptr(Longint(destPtr) + newBitMap.rowBytes);
  75.                     end;
  76.                 if bitchar = BIT07 then
  77.                     begin
  78.                         bitchar := BIT00;
  79.                         destColPtr := Ptr(Longint(destColPtr) - 1);
  80.                     end
  81.                 else
  82.                     begin
  83.                         bitchar := BSL(bitchar, 1);
  84.                     end;
  85.  
  86.                 destPtr := destColPtr;
  87.  
  88.                 srcrows := srcrows - 1;
  89.             end;
  90.  
  91.     (* remove src bitmap's baseAddr (portbits for offscreen port) *)
  92.         DisposPtr(Ptr(macBitMap.baseAddr));
  93.  
  94.     (* store new src in object *)
  95.         macBitMap := newBitMap;
  96.     end;
  97.  
  98. {main program}
  99.  
  100.     var
  101.         mainWinPtr: WindowPtr;
  102.         error: OSErr;
  103.         windRect, ovalRect, myBounds: Rect;
  104.         myRowBytes: Integer;
  105.  
  106. (* There is NO reason to check whether ColorQD exists in this program!. *)
  107. begin
  108.     (* Initialize all the needed managers. *)
  109. {$IFC UNDEFINED THINK_PASCAL}
  110.     InitGraf(qd.thePort);
  111.     InitFonts;
  112.     InitWindows;
  113.     InitMenus;
  114.     TEInit;
  115.     InitDialogs(nil);
  116. {$ENDC}
  117.     InitCursor;
  118.  
  119.     (* Define output window with an inset clip region. *)
  120.     SetRect(windRect, 100, 100, 404, 404);
  121. {Make sure it fits on the screen}
  122.     if windRect.bottom > screenBits.bounds.bottom then
  123.         OffSetRect(windRect, 0, screenBits.bounds.bottom - windRect.bottom);
  124.     mainWinPtr := NewWindow(nil, windRect, 'John', true, documentProc, WindowPtr(-1), false, 0);
  125.     SetPort(mainWinPtr);
  126.  
  127.     SetRect(windRect, 0, 0, 304, 304);
  128.     EraseRect(windRect);
  129.     SetRect(ovalRect, 15, 15, 60, 120);
  130.     PaintOval(ovalRect);
  131.     MoveTo(10, 140);
  132.     DrawString('Hi there.');
  133.     MoveTo(0, 0);
  134.     LineTo(303, 303);
  135.     MoveTo(0, 303);
  136.     LineTo(303, 0);
  137.  
  138.     (* rotate boundary rectangle *)
  139.     myBounds := windRect;
  140.     myRowBytes := BSR(myBounds.right - myBounds.left + 7, 3);
  141. {macBitMap := (BitMap * NewPtrClear(sizeof(BitMap));}
  142.     macBitMap.baseAddr := Ptr(NewPtrClear(myRowBytes * (myBounds.bottom - myBounds.top)));
  143.     macBitMap.bounds := myBounds;
  144.     macBitMap.rowBytes := myRowBytes;
  145.  
  146.     CopyBits(mainWinPtr^.portBits, macBitMap, windRect, macBitMap.bounds, 0, nil);
  147.  
  148.     (* Wait until user clicks button. *)
  149.     repeat
  150.     until Button;
  151.  
  152.     (* Wait until user clicks button. *)
  153.     repeat
  154.         begin
  155.             Rotate;
  156.             CopyBits(macBitMap, mainWinPtr^.portBits, macBitMap.bounds, windRect, 0, nil);
  157.         end
  158.     until Button;
  159. end.